From: Andrea Corallo <acorallo@gnu.org>
Date: Tue, 17 Jun 2025 07:06:45 +0000 (+0200)
Subject: Nativecomp don't error with undeclared types (bug#6573) (don't merge)
X-Git-Tag: archive/raspbian/1%30.2+1-2+rpi1^2~2^2~24^2~35
X-Git-Url: https://dgit.raspbian.org/%22http:/www.example.com/cgi/%22https://%22%22/%22http:/www.example.com/cgi/%22https:/%22%22?a=commitdiff_plain;h=05ecb2b8f0216aa3f391ee661aad4d61fd6aed0e;p=emacs.git

Nativecomp don't error with undeclared types (bug#6573) (don't merge)

Backporting f38e969e472 from trunk to emacs-30

* test/src/comp-resources/comp-test-funcs.el (comp-test-76573-1-f): New
function.
* lisp/emacs-lisp/comp-cstr.el (comp-supertypes): Don't error if 'type'
is unknown.
---

diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 52ed73ff5c3..ca59eb04901 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -336,9 +336,13 @@ Return them as multiple value."
       (nreverse res))))
 
 (defun comp-supertypes (type)
-  "Return the ordered list of supertypes of TYPE."
-  (or (assq type (comp-cstr-ctxt-typeof-types comp-ctxt))
-      (error "Type %S missing from typeof-types!" type)))
+   "Return the ordered list of supertypes of TYPE."
+   (or (assq type (comp-cstr-ctxt-typeof-types comp-ctxt))
+       (progn
+	 (display-warning
+	  'native-compiler
+	  (format "Unknown type %S" type))
+	 '(t))))
 
 (defun comp--union-typesets (&rest typesets)
   "Union types present into TYPESETS."
diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el
index 72fe71aa359..837ef018efb 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -562,6 +562,26 @@
 (defun comp-test-67883-1-f ()
   '#1=(1 . #1#))
 
+(cl-defstruct comp-test-73270-base)
+(cl-defstruct
+    (comp-test-73270-child1 (:include comp-test-73270-base)))
+(cl-defstruct
+    (comp-test-73270-child2 (:include comp-test-73270-base)))
+(cl-defstruct
+    (comp-test-73270-child3 (:include comp-test-73270-base)))
+(cl-defstruct
+    (comp-test-73270-child4 (:include comp-test-73270-base)))
+
+(defun comp-test-73270-1-f (x)
+  (cl-typecase x
+    (comp-test-73270-child1 'child1)
+    (comp-test-73270-child2 'child2)
+    (comp-test-73270-child3 'child3)
+    (comp-test-73270-child4 'child4)))
+
+(defun comp-test-76573-1-f ()
+  (record 'undeclared-type))
+
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; Tromey's tests ;;